home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol178 / arrow.bas (.txt) next >
Encoding:
GW-BASIC  |  1986-11-25  |  34.1 KB  |  1,194 lines
  1. 10000   CLS:SCREEN 1:COLOR 8,2:KEY OFF
  2. 10010  GOSUB 10070 ' define arrays, constants and variables
  3. 10020  GOSUB 10260 ' define all kinds of arrows
  4. 10030  GOSUB 14790 ' divide the screen
  5. 10040  DRAW"bm160,100":COLOR 7,0
  6. 10050  GOSUB 11700 ' main loop
  7. 10060  REM = arrays & constants ====
  8. 10070  DEFINT A,W,I,D,B
  9. 10080  KEY(10) ON:ON KEY(10) GOSUB 21310 'interup a crazy subroutine
  10. 10090  ON ERROR GOTO 18210:COLOR 1
  11. 10100  DIR=1:FRAME=1:RATIO=1:NEWPR=0:SCORE=0:UPDOWN$="down"
  12. 10110  DIM ARRW(6,7,2),BOX(20),PNT%(3),WERASE(41),WUP(17),WDOWN(33),DAYS$(6)
  13. 10120  DIM ARROW(6),T$(20),SUB$(119),SUBNAME$(119),CRSR%(9),CRSRI%(9):COLOR 5
  14. 10130  DIM SUBSTCK$(40),STCKNAME$(40),STCKLOOP(40):STCKMAX=40
  15. 10140  DIM SCRL(856),SCRM(2139),SCRR(856),VAR(9),TEXTCRS%(9),BRUB(9),BRUBV(16)
  16. 10150  BACK$=CHR$(29)+CHR$(0)+CHR$(29):COLOR 2
  17. 10160  ERS$=STRING$(8,0):ERS=0:XC=70:XL=70:YC=0:YL=0
  18. 10170  E=3:CLRF=0:CLRB=3:TEXTURE=&HFFFF:COLOR 4
  19. 10180  X=160:Y=104:STP=8:DX=2:DY=2:C=3:TM=0
  20. 10190  AVAILSUB=-1:MAXSUB=87:PRGRM=0:RUBON=0:DAYREM=1
  21. 10200  SREM=0:TREM=-1:SSREM=0:TTREM=-1:HREM=0:MINREM=0:HOUREM=0:AMPMREM$="A"
  22. 10210  CRNTSUB=-1 ' current sub pointer
  23. 10220  WDTH=1:BCKGR=7:PLT=0:BCKGR$="white":COLOR BCKGR,PLT
  24. 10230  ARROW(0)=10:ARROW(1)=5:VARPR=0:SCRPOS$="right":FSTSLW=0
  25. 10240  GET(1,1)-(69,190),SCRL:GET(70,1)-(248,190),SCRM:GET(249,1)-(317,190),SCRR
  26. 10250  RETURN
  27. 10260  REM == arrows and other cursors ===
  28. 10270  FOR W=0 TO 2:FOR D=0 TO 7:COLOR D+8:FOR I=0 TO 6
  29. 10310     READ ARRW(I,D,W)
  30. 10320    NEXT I:NEXT D:NEXT W
  31. 10350  DATA 10,5,12,15,-16132,15,12
  32. 10360  DATA 10,5,192,51,15,63,0
  33. 10370  DATA 10,5,12,12,-16129,51,12
  34. 10380  DATA 10,5,-16384,51,60,63,0
  35. 10390  DATA 10,5,12,60,-16177,60,12
  36. 10400  DATA 10,5,0,63,60,51,-16384
  37. 10410  DATA 10,5,12,51,-16129,12,12
  38. 10420  DATA 10,5,0,63,15,51,192
  39. 10430  DATA 10,5,12,-16369,-16132,-16369,12
  40. 10440  DATA 10,5,192,51,15,-16321,3
  41. 10450  DATA 10,5,12,12,-16129,51,63
  42. 10460  DATA 10,5,-16384,51,60,255,48
  43. 10470  DATA 10,5,12,252,-16177,252,12
  44. 10480  DATA 10,5,48,255,60,51,-16384
  45. 10490  DATA 10,5,63,51,-16129,12,12
  46. 10500  DATA 10,5,3,-16321,15,51,192
  47. 10510  DATA 10,5,-16369,-16372,-16132,-16372,-16369
  48. 10520  DATA 10,5,192,51,-16369,63,12
  49. 10530  DATA 10,5,12,12,-16129,-16192,-16129
  50. 10540  DATA 10,5,-16384,51,252,63,12
  51. 10550  DATA 10,5,252,204,-16177,204,252
  52. 10560  DATA 10,5,12,63,252,51,-16384
  53. 10570  DATA 10,5,-16129,-16192,-16129,12,12
  54. 10580  DATA 10,5,12,63,-16369,51,192
  55. 10590  FOR I=2 TO 6:ARROW(I)=ARRW(I,0,0):NEXT I
  56. 10600  WERASE(0)=80:WERASE(1)=8
  57. 10610  FOR I=2 TO 41:WERASE(I)=-1:NEXT
  58. 10620  WUP(0)=32:WUP(1)=8
  59. 10630  FOR I=2 TO 17:WUP(I)=-1:NEXT
  60. 10640  WDOWN(0)=64:WDOWN(1)=8
  61. 10650  FOR I=2 TO 33:WDOWN(I)=-1:NEXT
  62. 10660  FOR I=0 TO 9
  63. 10670   READ CRSR%(I)
  64. 10680  NEXT I
  65. 10690  FOR I=0 TO 9
  66. 10700   READ CRSRI%(I)
  67. 10710  NEXT
  68. 10720  FOR I=0 TO 9
  69. 10730   READ TEXTCRS%(I)
  70. 10740  NEXT
  71. 10750  DATA 16,8,0,0,0,0,0,0,-1,-1
  72. 10760  DATA 16,8,0,0,0,-1,-1,-1,-1,-1
  73. 10770  DATA 16,8,-1,-1,-1,-1,-1,-1,-1,-1
  74. 10780  FOR I=0 TO 3
  75. 10790   READ PNT%(I)
  76. 10800  NEXT I
  77. 10810  DATA 6,3,12288,0
  78. 10820  BRUB(0)=16:BRUB(1)=8:BRUBV(0)=20:BRUBV(1)=10
  79. 10830  FOR I=2 TO 9:BRUB(I)=0:NEXT I
  80. 10840  FOR I=2 TO 16
  81. 10850   READ BRUBV(I)
  82. 10860  NEXT I
  83. 10870  DATA -1,-16144,12288,192,-16336,12288,192,-16336,12288,192,-16336
  84. 10880  DATA 12288,192,-208,-3841
  85. 10890  FOR I=0 TO 6:READ DAYS$(I):NEXT I
  86. 10900  DATA "Saturday ","Sunday   ","Monday   ","Tuesday  "
  87. 10910  DATA "Wednesday","Thursday ","Friday   "
  88. 10920  RETURN
  89. 10930  REM = erase menu ====
  90. 10940  LINE(0,0)-(69,191),0,BF
  91. 10950  RETURN
  92. 10960  REM == MENUS' SECTION ===
  93. 10970  REM == main menu ====
  94. 10980  GOSUB 10930 ' erase previous menu
  95. 10990  'main menu
  96. 11000  LOCATE 1,1:PRINT "draw":PRINT:PRINT"paint":PRINT:PRINT"change":PRINT
  97. 11010  PRINT"picture":PRINT:PRINT"type":PRINT:PRINT"program":PRINT
  98. 11020  PRINT"clock":PRINT:PRINT"week":PRINT:PRINT "exit"
  99. 11030  RETURN
  100. 11040  ' draw menu
  101. 11050  GOSUB 10930
  102. 11060  LOCATE 1,1:PRINT "left":PRINT"right":PRINT"ahead":PRINT"back":PRINT"turn"
  103. 11070  PRINT:PRINT "up,down":IF E=0 THEN PUT(0,49),WUP ELSE PUT(23,48),WDOWN
  104. 11080  PRINT:PRINT "center-":PRINT "circle":PRINT:PRINT"line-end":PRINT
  105. 11090  PRINT "erase":IF ERS=1 THEN PUT(0,105),WERASE
  106. 11100  PRINT:PRINT "box-fix":PRINT"put":PRINT"sprite":PRINT
  107. 11110  PRINT "program":PRINT "var(#=)":PRINT "status":PRINT"quit";
  108. 11120  LINE(70,0)-(319,191),CLRB,B
  109. 11130  RETURN
  110. 11140  ' picture menu
  111. 11150  GOSUB 10930
  112. 11160  LOCATE 1,1:PRINT "save":PRINT:PRINT"load":PRINT:PRINT"name":PRINT
  113. 11170  PRINT "frame":PRINT:PRINT"screen":PRINT:PRINT"print":PRINT
  114. 11180  PRINT"files":PRINT:PRINT "program":PRINT:PRINT:PRINT"quit"
  115. 11190  IF FRAME=1 THEN PUT(0,48),WERASE
  116. 11200  RETURN
  117. 11210  ' paint menu
  118. 11220  GOSUB 10930
  119. 11230  LOCATE 1,1:PRINT "ground":PRINT:PRINT"fill":PRINT:PRINT"arrow":PRINT
  120. 11240  PRINT "program":PRINT:PRINT:PRINT"quit"
  121. 11250  RETURN
  122. 11260  ' color menu
  123. 11270  GOSUB 10930
  124. 11280  LOCATE 1,1:PRINT "red":PRINT:PRINT"green":PRINT:PRINT"blue":PRINT
  125. 11290  PRINT"white":PRINT:PRINT"yellow":PRINT:PRINT"black":PRINT:PRINT"grey"
  126. 11300  PRINT:PRINT"brown":PRINT:PRINT"purple"
  127. 11310  PRINT:PRINT"bright":PRINT:PRINT"program":PRINT:PRINT"quit";
  128. 11320  RETURN
  129. 11330  ' drawing color
  130. 11340  GOSUB 10930
  131. 11350  LOCATE 1,3:PRINT" ";0
  132. 11360  PRINT "green":PRINT "red":PRINT "brown"
  133. 11370  LOCATE 6,3:PRINT" ";1
  134. 11380  PRINT "cyan":PRINT "purple":PRINT "white"
  135. 11390  LOCATE 12,1:PRINT"quit"
  136. 11400  RETURN
  137. 11410  ' change menu
  138. 11420  GOSUB 10930
  139. 11430  LOCATE 1,1:PRINT"new":PRINT:PRINT"wide":PRINT"narrow":PRINT:PRINT"step"
  140. 11440  PRINT:PRINT "visible":PRINT:PRINT"undo":PRINT:PRINT"eastwest":PRINT
  141. 11450  PRINT "net":PRINT:PRINT"flat":PRINT"tall":PRINT:PRINT"program"
  142. 11460  LOCATE 22,1:PRINT "quit"
  143. 11470  RETURN
  144. 11480  REM == SUB -- READ COMMAND ====
  145. 11490  A$="" : B$="" : LOOP=1 : SWITCH=0 : LOOP$="" : FIRST=0
  146. 11500  LOCATE 25,1     
  147. 11510  WHILE B$<>CHR$(13)
  148. 11520   IF CRNTSUB=-1 THEN B$=INKEY$ ELSE GOSUB 16590
  149. 11530   IF LEN(B$)=2 THEN B$=MID$(B$,2,1):IF ASC(B$)=75 THEN IF POS(1)<>1                                                               THEN B$=BACK$
  150. 11540   IF B$=CHR$(8) THEN IF POS(1)<>1 THEN B$=BACK$
  151. 11550   IF POS(0)=39 THEN LINE(0,192)-(320,200),0,BF:LOCATE 25,1
  152. 11560   IF FIRST=0 AND B$<>"" THEN FIRST=1 : LINE(0,192)-(320,200),0,BF
  153. 11570   IF B$="," AND PRGRM=0 THEN B$=CHR$(13)
  154. 11580   IF B$>CHR$(19) THEN PRINT B$;
  155. 11590   IF B$>CHR$(64) AND B$<CHR$(91) THEN B$=CHR$(ASC(B$)+32)
  156. 11600   IF B$=" " AND PRGRM=0 THEN SWITCH=1
  157. 11610   IF B$<>CHR$(13) THEN IF SWITCH=0 THEN A$=A$+B$ ELSE LOOP$=LOOP$+B$
  158. 11620   IF B$=BACK$ THEN IF SWITCH=0 THEN A$=MID$(A$,1,LEN(A$)-4)                                                    ELSE LOOP$=MID$(LOOP$,1,LEN(LOOP$)-4)
  159. 11630  WEND
  160. 11640  LOOP=VAL(LOOP$):IF LOOP=0 THEN LOOP=1
  161. 11650  IF LEFT$(LOOP$,4)=" var" THEN LOOP=VAR(VAL(MID$(LOOP$,5,1)))
  162. 11660  IF LEFT$(A$,3)="var" AND MID$(A$,5,1)<>"=" AND A$<>"var"                             THEN A$=MID$(STR$(VAR(VAL(MID$(A$,4,1)))),2,2)
  163. 11670  LINE(0,192)-(320,200),0,BF
  164. 11680  RETURN
  165. 11700  REM == MAIN LOOP ====
  166. 11710  DUMMY=0:PUT(X-DX,Y-DY),ARROW
  167. 11720  WHILE DUMMY<>1
  168. 11730   GOSUB 10970 ' menu
  169. 11740   GOSUB 11480 ' command
  170. 11750   IF A$="draw"    THEN GOSUB 11890
  171. 11760   IF A$="paint"   THEN GOSUB 13390
  172. 11770   IF A$="change"  THEN GOSUB 14280
  173. 11780   IF A$="picture" THEN GOSUB 14890
  174. 11790   IF A$="exit"    THEN GOSUB 14860
  175. 11800   IF A$="program" THEN GOSUB 16340
  176. 11810   IF A$="clock"   THEN GOSUB 21650
  177. 11820   IF A$="type"    THEN GOSUB 19670
  178. 11830   IF A$="week"    THEN GOSUB 21390
  179. 11850    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  180. 11860    NEXT S
  181. 11870  WEND
  182. 11880  RETURN
  183. 11890  REM == SUB -- DRAW ======
  184. 11900  GOSUB 11040
  185. 11910  GOSUB 11480:SLCT=0
  186. 11930   IF A$="var"    THEN GOSUB 19370
  187. 11940   IF A$="line"   THEN GOSUB 12320
  188. 11950   IF A$="center" THEN GOSUB 12170
  189. 11960   IF A$="left" THEN SLCT=1 ELSE IF A$="right" THEN SLCT=2 ELSE IF A$="ahead" THEN SLCT=3 ELSE IF A$="back" THEN SLCT=4 ELSE IF A$="turn" THEN SLCT=5
  190. 11970   IF A$="up" THEN GOSUB 12540 ELSE IF A$="down" THEN GOSUB 12580 ELSE IF A$="erase" THEN GOSUB 14500
  191. 11980   IF A$="status" THEN GOSUB 19430
  192. 11990   IF A$="box"    THEN GOSUB 13220
  193. 12000   IF A$="fix"    THEN GOSUB 13250
  194. 12010   IF A$="put"    THEN GOSUB 13360
  195. 12020   IF A$="sprite" THEN GOSUB 20260
  196. 12030   IF A$="f1" OR A$="circle" THEN GOSUB 12200
  197. 12040   IF A$="f2" OR A$="end" THEN GOSUB 12350
  198. 12050   IF LEFT$(A$,3)="var" THEN GOSUB 19180
  199. 12060    FOR L=1 TO LOOP
  200. 12070     ON SLCT GOSUB 12390,12430,12470,12500,13180
  201. 12080    NEXT L
  202. 12090   IF A$="program" THEN GOSUB 16340:GOSUB 11040
  203. 12100    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  204. 12110    NEXT S
  205. 12130   IF A$="if.neg" THEN GOSUB 21340
  206. 12140  IF A$<>"quit" THEN 11910
  207. 12150  A$=""
  208. 12160  RETURN
  209. 12170  ' circle ==
  210. 12180  XC=X : YC=Y
  211. 12190  RETURN 12140
  212. 12200  R=SQR((XC-X)^2+((YC-Y)/RATIO)^2):IF RATIO>1 THEN R=R*RATIO
  213. 12210  PUT(X-DX,Y-DY),ARROW
  214. 12220  VIEW(70,0)-(319,191)
  215. 12230  IF ERS=1 THEN CL=0 ELSE CL=CLRB
  216. 12240  CIRCLE(XC-70,YC),R,CL,,,RATIO
  217. 12250  IF WDTH=1 THEN GOTO 12290
  218. 12260  FOR W=1 TO WDTH-1
  219. 12270   CIRCLE(XC-70,YC),R+W,CL,,,RATIO:CIRCLE(XC-70,YC),R-W,CL,,,RATIO
  220. 12280  NEXT W
  221. 12290  VIEW
  222. 12300  PUT(X-DX,Y-DY),ARROW
  223. 12310  RETURN 12140
  224. 12320  ' line
  225. 12330  XL=X : YL=Y
  226. 12340  RETURN 12140
  227. 12350  PUT(X-DX,Y-DY),ARROW:IF ERS=1 THEN CL=0 ELSE CL=CLRB
  228. 12370  LINE(XL,YL)-(X,Y),CL:PUT(X-DX,Y-DY),ARROW
  229. 12380  RETURN 12140
  230. 12390  'left ===
  231. 12400  DIR=DIR-2:IF DIR<1 THEN DIR=DIR+8
  232. 12410  GOSUB 12620
  233. 12420  RETURN
  234. 12430  'right ==
  235. 12440  DIR=DIR+2:IF DIR>8 THEN DIR=DIR-8
  236. 12450  GOSUB 12620
  237. 12460  RETURN
  238. 12470  'ahead ==
  239. 12480  GOSUB 12620
  240. 12490  RETURN
  241. 12500  'BACK ===
  242. 12510  DIR=DIR+4:IF DIR>8 THEN DIR=DIR-8
  243. 12520  GOSUB 12620
  244. 12530  RETURN
  245. 12540  ' up ==
  246. 12550  IF UPDOWN$="down" THEN PUT(0,49),WUP:PUT(23,48),WDOWN
  247. 12560  UPDOWN$="up":E=0
  248. 12570  RETURN
  249. 12580  ' down ==
  250. 12590  IF UPDOWN$="up" THEN PUT(0,49),WUP:PUT(23,48),WDOWN
  251. 12600  UPDOWN$="down":E=CLRB
  252. 12610  RETURN
  253. 12620  ' modify ARROW and x,y ==
  254. 12630  PUT(X-DX,Y-DY),ARROW
  255. 12640  ON DIR GOSUB 13020,13040,13060,13080,13100,13120,13140,13160
  256. 12650  GOSUB 12690
  257. 12660  IF UPDOWN$="down" OR ERS=1 THEN GOSUB 12740
  258. 12670  X=X1 : Y=Y1 :PUT(X-DX,Y-DY),ARROW
  259. 12680  RETURN
  260. 12690  'change arrow when wdth or dir changes
  261. 12700  FOR I=2 TO 6
  262. 12710   ARROW(I)=ARRW(I,DIR-1,WDTH-1)
  263. 12720  NEXT I
  264. 12730  RETURN
  265. 12740  ' draw a line ===
  266. 12750  LINE(X,Y)-(X1,Y1),E
  267. 12760  IF WDTH=1 THEN RETURN
  268. 12770  D=(DIR MOD 4)+1
  269. 12780  ON D GOTO 12960,12840,12900,12790
  270. 12790  FOR I=1 TO WDTH-1
  271. 12810   LINE(X-I,Y)-(X1-I,Y1),E:LINE(X+I,Y)-(X1+I,Y1),E
  272. 12820  NEXT I
  273. 12830  RETURN
  274. 12840  FOR I=1 TO WDTH-1
  275. 12860   LINE(X,Y-I)-(X1,Y1-I),E:LINE(X,Y+I)-(X1,Y1+I),E
  276. 12870  NEXT I
  277. 12880  RETURN
  278. 12900   LINE(X+1,Y)-(X1+1,Y1),E:LINE(X,Y+1)-(X1,Y1+1),E
  279. 12910   IF WDTH=2 THEN RETURN
  280. 12930   LINE(X+1,Y-1)-(X1+1,Y1-1),E:LINE(X-1,Y+1)-(X1-1,Y1+1),E
  281. 12940  RETURN
  282. 12960   LINE(X+1,Y)-(X1+1,Y1),E:LINE(X,Y-1)-(X1,Y1-1),E
  283. 12970   IF WDTH=2 THEN RETURN
  284. 12990   LINE(X+1,Y+1)-(X1+1,Y1+1),E:LINE(X-1,Y-1)-(X1-1,Y1-1),E
  285. 13000  RETURN
  286. 13010  '
  287. 13020  X1=X+STP : Y1=Y     : IF X1>317 THEN X1=X:BEEP
  288. 13030  RETURN
  289. 13040  X1=X+STP : Y1=Y+STP : IF X1>317 OR Y1>189 THEN X1=X:Y1=Y:BEEP
  290. 13050  RETURN
  291. 13060  X1=X     : Y1=Y+STP : IF Y1>189 THEN Y1=Y:BEEP
  292. 13070  RETURN
  293. 13080  X1=X-STP : Y1=Y+STP : IF X1<72 OR Y1>189 THEN X1=X:Y1=Y:BEEP
  294. 13090  RETURN
  295. 13100  X1=X-STP : Y1=Y     : IF X1<72 THEN X1=X:BEEP
  296. 13110  RETURN
  297. 13120  X1=X-STP : Y1=Y-STP : IF X1<72 OR Y1<2 THEN X1=X:Y1=Y:BEEP
  298. 13130  RETURN
  299. 13140  X1=X     : Y1=Y-STP : IF Y1<2 THEN Y1=Y:BEEP
  300. 13150  RETURN
  301. 13160  X1=X+STP : Y1=Y-STP : IF X1>317 OR Y1<2 THEN X1=X:Y1=Y:BEEP
  302. 13170  RETURN
  303. 13180  'turn ===
  304. 13190  DIR=DIR-1:IF DIR<1 THEN DIR=DIR+8
  305. 13200  GOSUB 12620
  306. 13210  RETURN
  307. 13220  'box ==
  308. 13230  XB=X : YB=Y
  309. 13240  RETURN 12140
  310. 13250  'fix ==
  311. 13260  ERASE BOX
  312. 13270  XC=X : YC=Y
  313. 13280  IF XC>XB THEN SWAP XC,XB
  314. 13290  IF YC>YB THEN SWAP YC,YB
  315. 13310  PUT(X-DX,Y-DY),ARROW:IN=(4+INT((XB-XC+1)*2+7)/8)*(YB-YC+1)/2
  316. 13320  DIM BOX(IN):GET(XB,YB)-(XC,YC),BOX:PUT(X-DX,Y-DY),ARROW
  317. 13350  RETURN 12140
  318. 13360  'put ==
  319. 13370  PUT(X,Y),BOX
  320. 13380  RETURN 12140
  321. 13390  ' PAINT
  322. 13400  A$=""
  323. 13410  WHILE A$<>"quit"
  324. 13420  GOSUB 11210
  325. 13430   GOSUB 11480
  326. 13440   IF A$="ground" THEN GOSUB 13540
  327. 13450   IF A$="fill"  THEN GOSUB 15690
  328. 13460   IF A$="arrow" THEN GOSUB 14140
  329. 13470   IF A$="program" THEN GOSUB 16340
  330. 13480    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  331. 13490    NEXT S
  332. 13510  WEND
  333. 13520  A$=""
  334. 13530  RETURN
  335. 13540  ' color ===
  336. 13550  GOSUB 11260
  337. 13560  A$=""
  338. 13570  WHILE A$<>"quit"
  339. 13580   GOSUB 11480:BC=-1
  340. 13590   IF A$="red" THEN BC=4
  341. 13600   IF A$="green" THEN BC=2
  342. 13610   IF A$="blue"  THEN BC=1
  343. 13620   IF A$="white" THEN BC=7
  344. 13630   IF A$="brown" THEN BC=6
  345. 13640   IF A$="purple" THEN BC=5
  346. 13650   IF A$="yellow" THEN BC=14
  347. 13660   IF A$="black" THEN BC=0
  348. 13670   IF A$="grey" THEN BC=8
  349. 13680   IF A$="bright" THEN BC=BCKGR+8
  350. 13690   IF BC<>-1 THEN BCKGR=BC:IF BC<8 THEN BCKGR$=A$
  351. 13700   IF A$="program" THEN GOSUB 16340
  352. 13710    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  353. 13720    NEXT S
  354. 13740  COLOR BCKGR,PLT
  355. 13750  WEND
  356. 13760  A$=""
  357. 13770  RETURN
  358. 13780  '
  359. 13790  IF CRNTSUB=-1 THEN RETURN
  360. 13800   FOR S=0 TO AVAILSUB
  361. 13810    IF A$=SUBNAME$(S) THEN GOSUB 16500
  362. 13820   NEXT S
  363. 13830  RETURN
  364. 13840  ' color fill ====
  365. 13850  IF PLT=0 THEN GOSUB 13920
  366. 13860  IF PLT=1 THEN GOSUB 14030
  367. 13870  IF C<>-1 THEN CLRF=C
  368. 13880  PUT(X-DX,Y-DY),ARROW
  369. 13890  PAINT(X,Y),CLRF,CLRB
  370. 13900  PUT(X-DX,Y-DY),ARROW
  371. 13910  RETURN 15690
  372. 13920  ' filling and drawing color - plt=0 =
  373. 13930  GOSUB 10930
  374. 13940  LOCATE 1,1:PRINT 0:PRINT BCKGR$
  375. 13950  PRINT 1:PRINT "green":PRINT 2:PRINT"red":PRINT 3:PRINT"brown"
  376. 13960  LOCATE 14,1:PRINT "go"
  377. 13970  A$="":C=-1
  378. 13980  WHILE A$<>"go"
  379. 13990   GOSUB 11480
  380. 14000   IF A$>="0" AND A$<="3" THEN C=VAL(A$)
  381. 14010  WEND
  382. 14020  RETURN
  383. 14030  ' filling and drawing color - plt=1 =
  384. 14040  GOSUB 10930
  385. 14050  LOCATE 1,1:PRINT 0:PRINT BCKGR$:PRINT:PRINT 1:PRINT "cyan"
  386. 14060  PRINT:PRINT 2:PRINT "purple":PRINT:PRINT 3:PRINT "white"
  387. 14070  LOCATE 14,1:PRINT "go"
  388. 14080  A$="":C=-1
  389. 14090  WHILE A$<>"go"
  390. 14100   GOSUB 11480
  391. 14110   IF A$>="0" AND A$<="3" THEN C=VAL(A$)
  392. 14120  WEND
  393. 14130  RETURN
  394. 14140  ' changing drawing color ==
  395. 14150  GOSUB 11330
  396. 14160  A$=""
  397. 14170  WHILE A$<>"quit"
  398. 14180   GOSUB 11480
  399. 14190   IF A$="0" THEN PLT=0:GOSUB 13920
  400. 14200   IF A$="1" THEN PLT=1:GOSUB 14030
  401. 14210   IF C<>-1 THEN E=C : CLRB=C
  402. 14220   IF A$<>"quit" THEN GOSUB 11330
  403. 14230   LINE(70,0)-(319,191),CLRB,B:COLOR BCKGR,PLT
  404. 14240  WEND
  405. 14250  LINE(70,0)-(319,191),CLRB,B:A$=""
  406. 14270  RETURN
  407. 14280  ' change ====
  408. 14290  GOSUB 11410:A$=""
  409. 14300  WHILE A$<>"quit"
  410. 14310  GOSUB 11480:SLCT=0
  411. 14320   IF A$="new" THEN GOSUB 16260
  412. 14330   IF A$="wide" THEN SLCT=1 ELSE IF A$="narrow" THEN SLCT=2
  413. 14340   IF A$="step" THEN GOSUB 14700
  414. 14350   IF A$="visible" THEN GOSUB 14830
  415. 14360   IF A$="program" THEN GOSUB 16340
  416. 14370   IF A$="eastwest" THEN IF SCRPOS$="right" THEN GOSUB 14580 ELSE GOSUB 14620
  417. 14380   IF A$="net" THEN GOSUB 20120
  418. 14390   IF A$="undo" THEN GOSUB 20210
  419. 14400   IF A$="tall" THEN SLCT=3 ELSE IF A$="flat" THEN SLCT=4
  420. 14410    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  421. 14420    NEXT S
  422. 14440   FOR L=1 TO LOOP
  423. 14450    ON SLCT GOSUB 14540,14660,14730,14760
  424. 14460   NEXT L
  425. 14470  WEND
  426. 14480  A$=""
  427. 14490  RETURN
  428. 14500  ' erase ===
  429. 14510  PUT(0,105),WERASE
  430. 14520  IF ERS=0 THEN ERS=1:E1=E:E=0 ELSE ERS=0:E=E1
  431. 14530  RETURN
  432. 14540  ' wide ====
  433. 14550  WDTH=WDTH+1:IF WDTH>3 THEN WDTH=3
  434. 14560  PUT(X-DX,Y-DY),ARROW:GOSUB 12690:PUT(X-DX,Y-DY),ARROW
  435. 14570  RETURN
  436. 14580  'right ====
  437. 14590  PUT(X-DX,Y-DY),ARROW:GET(71,1)-(249,190),SCRM:GET(250,1)-(318,190),SCRR
  438. 14600  PUT(71,1),SCRL,PSET:PUT(140,1),SCRM,PSET:PUT(X-DX,Y-DY),ARROW
  439. 14610  SCRPOS$="left":RETURN
  440. 14620  'left ===
  441. 14630  PUT(X-DX,Y-DY),ARROW:GET(71,1)-(139,190),SCRL:GET(140,1)-(318,190),SCRM
  442. 14640  PUT(71,1),SCRM,PSET:PUT(250,1),SCRR,PSET:PUT(X-DX,Y-DY),ARROW
  443. 14650  SCRPOS$="right":RETURN
  444. 14660  ' narrow ====
  445. 14670  WDTH=WDTH-1:IF WDTH<1 THEN WDTH=1
  446. 14680  PUT(X-DX,Y-DY),ARROW:GOSUB 12690:PUT(X-DX,Y-DY),ARROW
  447. 14690  RETURN
  448. 14700  ' step ====
  449. 14710  STP=LOOP
  450. 14720  RETURN
  451. 14730  'tall ===
  452. 14740  RATIO=RATIO*6/5
  453. 14750  RETURN
  454. 14760  'flat ===
  455. 14770  RATIO=RATIO*5/6
  456. 14780  RETURN
  457. 14790  REM = SUB -- clean the drawing area ====
  458. 14800  LINE (70,0)-(319,191),0,BF
  459. 14810  LINE (70,0)-(319,191),CLRB,B
  460. 14820  RETURN
  461. 14830  ' a one time visibility ===
  462. 14840  PUT(X-DX,Y-DY),ARROW
  463. 14850  RETURN
  464. 14860  '    end-end-end ====
  465. 14870  SCREEN 0:WIDTH 80:COLOR 14,1,1:CLS:END
  466. 14880  RETURN
  467. 14890  ' picture ===
  468. 14900  GOSUB 11140
  469. 14910  A$=""
  470. 14920  WHILE A$<>"quit"
  471. 14930   GOSUB 11480
  472. 14940   IF A$="save"    THEN GOSUB 15070
  473. 14950   IF A$="load"    THEN GOSUB 15220
  474. 14960   IF A$="name"    THEN GOSUB 15330
  475. 14970   IF A$="screen"  THEN GOSUB 15390
  476. 14980   IF A$="program" THEN GOSUB 16340
  477. 14990   IF A$="print"   THEN GOSUB 15510 ELSE IF A$="frame" THEN GOSUB 15660
  478. 15000   IF A$="files"   THEN GOSUB 22460
  479. 15010    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  480. 15020    NEXT S
  481. 15040  WEND
  482. 15050  A$=""
  483. 15060  RETURN
  484. 15070  ' save ====
  485. 15075  IF LOOP$<>"" THEN NME$=MID$(LOOP$,2)
  486. 15080  IF NME$="" THEN GOSUB 15330
  487. 15090  DEF SEG=&HB800:GOSUB 15160
  488. 15100  CLS:PUT(1,1),SCRL,PSET:PUT(70,1),SCRM,PSET:PUT(249,1),SCRR,PSET
  489. 15110  IF FRAME=1 THEN LINE(0,0)-(318,191),3,B
  490. 15120  BSAVE NME$+".pic",0,&H4000
  491. 15130  GOSUB 11140 : LINE(70,0)-(319,191),CLRB,B ' restore menu & frame
  492. 15140  DEF SEG:NME$="":GOSUB 15190
  493. 15150  RETURN
  494. 15160    PUT(X-DX,Y-DY),ARROW
  495. 15170  IF SCRPOS$="right" THEN GET(71,1)-(249,190),SCRM:GET(250,1)-(318,190),SCRR                        ELSE GET(71,1)-(139,190),SCRL:GET(140,1)-(318,190),SCRM
  496. 15180  RETURN
  497. 15190  IF SCRPOS$="right" THEN PUT(71,1),SCRM,PSET:PUT(250,1),SCRR,PSET                                   ELSE PUT(71,1),SCRL,PSET:PUT(140,1),SCRM,PSET
  498. 15200    PUT(X-DX,Y-DY),ARROW
  499. 15210  RETURN
  500. 15220  ' load ====
  501. 15230  IF LOOP$<>"" THEN NME$=MID$(LOOP$,2)
  502. 15240  IF NME$="" THEN GOSUB 15330
  503. 15250  DEF SEG=&HB800:BLOAD NME$+".pic",0
  504. 15260  IF ERT=53 OR ERT=52 OR ERT=71 THEN 15280
  505. 15270  GET(1,1)-(69,190),SCRL:GET(70,1)-(248,190),SCRM:GET(249,1)-(317,190),SCRR
  506. 15280  CLS:GOSUB 11140:PUT(71,1),SCRM,PSET:PUT(250,1),SCRR,PSET:SCRPOS$="right"
  507. 15290  DEF SEG:LINE(70,0)-(319,191),CLRB,B:NME$="":PUT(X-DX,Y-DY),ARROW:A$=""
  508. 15320  RETURN
  509. 15330  ' name ====
  510. 15340  LOCATE 25,30:PRINT"GIVE NAME!";:GOSUB 11480:NME$=A$
  511. 15380  RETURN
  512. 15390  ' screen ====
  513. 15410  GOSUB 15160
  514. 15430  CLS:PUT(1,1),SCRL,PSET:PUT(70,1),SCRM,PSET:PUT(249,1),SCRR,PSET
  515. 15440  IF FRAME=1 THEN LINE(0,0)-(318,191),3,B
  516. 15450  IF TM=1 THEN RETURN
  517. 15460  LOCATE 25,1:PRINT"hit a key to continue";:WHILE INKEY$="" : WEND:GOSUB 11140
  518. 15470  LINE(70,0)-(319,191),CLRB,B : LINE(0,192)-(320,200),0,BF
  519. 15480  GOSUB 15190
  520. 15500  RETURN
  521. 15510  'print ====
  522. 15530  GOSUB 15160
  523. 15540  CLS:PUT(1,1),SCRL,PSET:PUT(70,1),SCRM,PSET:PUT(249,1),SCRR,PSET
  524. 15550  IF FRAME=1 THEN LINE(0,0)-(318,191),3,B
  525. 15560  LOCATE 25,1:PRINT"Is your printer on? Is it (Y/N)?";
  526. 15570  K$="":WHILE K$="":K$=INKEY$:WEND
  527. 15580  IF K$<>"y" AND K$<>"Y" AND K$<>"N" AND K$<>"n" THEN 15560
  528. 15590  IF K$="N" OR K$="n" THEN 15620
  529. 15600  LINE(0,192)-(320,200),0,BF
  530. 15610  XPR!=-51973.8:PRNT=VARPTR(XPR!):CALL PRNT
  531. 15620  GOSUB 11140 : LINE(70,0)-(319,191),CLRB,B : LINE(0,192)-(320,200),0,BF
  532. 15630  GOSUB 15190
  533. 15650  RETURN
  534. 15660  ' frame ===
  535. 15670  PUT(0,48),WERASE:IF FRAME=1 THEN FRAME=0 ELSE FRAME=1
  536. 15680  RETURN
  537. 15690  ' fill ====
  538. 15700  GOSUB 10930:LOCATE 1,1:PRINT "color":PRINT:PRINT:PRINT"design"
  539. 15710  PRINT:PRINT:PRINT"quit":A$=""
  540. 15720  WHILE A$<>"quit"
  541. 15730   GOSUB 11480
  542. 15740   IF A$="color" THEN GOSUB 13840
  543. 15750   IF A$="design" THEN GOSUB 15820
  544. 15760    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  545. 15770    NEXT S
  546. 15790  WEND
  547. 15800  A$=""
  548. 15810  RETURN
  549. 15820  ' design fill ===
  550. 15830  GOSUB 10930
  551. 15840  T$(0)=CHR$(&H55)+CHR$(&HAA)
  552. 15850  T$(1)=CHR$(&H11)+CHR$(&H22)+CHR$(&H44)+CHR$(88)
  553. 15860  T$(2)=CHR$(&HC0)
  554. 15870  T$(3)=CHR$(&H3)+CHR$(&HC)+CHR$(&H30)+CHR$(&HC0)
  555. 15880  T$(4)=CHR$(&H81)+CHR$(&H18)+CHR$(&H18)+CHR$(&H81)
  556. 15890  T$(5)=CHR$(&H2)+CHR$(&H2)+CHR$(&HFF)+CHR$(&H20)+CHR$(&H20)+CHR$(&HFF)
  557. 15900  T$(6)=CHR$(&H3C)+CHR$(&HC3)+CHR$(&HC3)+CHR$(&H3C)
  558. 15910  T$(7)=CHR$(&H88)+CHR$(&H44)+CHR$(&H22)+CHR$(&H11)
  559. 15920  T$(8)=CHR$(&HCC)+CHR$(&H33)
  560. 15930  T$(9)=CHR$(&HC0)+CHR$(&H30)+CHR$(&HC)+CHR$(&H3)
  561. 15940  T$(10)=CHR$(&H33)
  562. 15950  T$(11)=CHR$(&H80)+CHR$(&H20)+CHR$(&H8)+CHR$(&H2)+CHR$(&H8)+CHR$(&H20)+CHR$(&H80)
  563. 15960  T$(12)=CHR$(&H18)+CHR$(&H24)+CHR$(&H42)+CHR$(&H81)
  564. 15970  T$(16)=CHR$(&HFF)+CHR$(&H3F)+CHR$(&HF)+CHR$(&H3)
  565. 15980  T$(14)=CHR$(&H80)+CHR$(&H82)+CHR$(&H84)+CHR$(&HA0)
  566. 15990  T$(13)=CHR$(&HAA)+CHR$(&H96)+CHR$(&H96)+CHR$(&HAA)
  567. 16000  T$(15)=CHR$(&H0)+CHR$(&HC3)+CHR$(&H3C)+CHR$(&HC3)+CHR$(&H0)
  568. 16010  T$(17)=CHR$(&H0)+CHR$(&H28)+CHR$(&H0)
  569. 16020  T$(18)=CHR$(&HC0)+CHR$(&HC0)+CHR$(&H30)+CHR$(&H30)
  570. 16030  T$(19)=CHR$(&H81)+CHR$(&H81)+CHR$(&H99)+CHR$(&H99)+CHR$(&H81)
  571. 16040  LOCATE 1,4:PRINT 0;
  572. 16050  LOCATE 1,7:PRINT 1;
  573. 16060  LINE(70,0)-(319,191),CLRB,B
  574. 16070  FOR I=1 TO 10
  575. 16080   LOCATE 2*I+1,1:PRINT I-1
  576. 16100  NEXT I
  577. 16110  FOR I=1 TO 10
  578. 16120   LINE(20,16*I)-(40,16*I+13),,B:LINE(43,16*I)-(63,16*I+13),,B
  579. 16150   PAINT(22,16*I+2),T$(I-1):PAINT(48,16*I+2),T$(I+10-1)
  580. 16160  NEXT I
  581. 16170  LOCATE 23,1:PRINT"quit":A$=""
  582. 16180  WHILE A$<>"quit"
  583. 16190   GOSUB 11480
  584. 16200   FOR S=0 TO AVAILSUB
  585. 16210    IF A$=SUBNAME$(S) THEN GOSUB 16500
  586. 16220   NEXT S
  587. 16230   IF A$>="0" AND A$<="9" THEN PUT(X-DX,Y-DY),ARROW:PAINT(X,Y),T$(VAL(A$)),CLRB:PUT(X-DX,Y-DY),ARROW
  588. 16240  WEND
  589. 16250  RETURN
  590. 16260  ' new ===
  591. 16270  CLS
  592. 16280  GET(1,1)-(69,190),SCRL:GET(70,1)-(248,190),SCRM:GET(249,1)-(317,190),SCRR
  593. 16290  LINE(70,0)-(319,191),CLRB,B:PUT(X-DX,Y-DY),ARROW:GOSUB 11410:ERS=0
  594. 16330  RETURN
  595. 16340  REM == SUB - PROGRAM ===
  596. 16350  IF LOOP$="" THEN GOSUB 16800:RETURN
  597. 16360  NMBR=-1 : PRGRM=1
  598. 16370  FOR I=0 TO AVAILSUB
  599. 16380   IF SUBNAME$(I)=LOOP$ THEN NMBR=I
  600. 16390  NEXT I
  601. 16400  IF NMBR=-1 THEN NMBR=AVAILSUB+1
  602. 16410  IF NMBR>MAXSUB THEN LOCATE 25,1:PRINT "No space available";:RETURN
  603. 16420  SUBNAME$(NMBR)=MID$(LOOP$,2,LEN(LOOP$)-1)
  604. 16430  GOSUB 11480
  605. 16440  SUB$(NMBR)=A$+LOOP$+CHR$(13)
  606. 16450  IF NMBR>AVAILSUB THEN AVAILSUB=NMBR
  607. 16470  A$="":PRGRM=0
  608. 16480  RETURN
  609. 16490  ' endsub - PROGRAM
  610. 16500  REM = generating the stack =
  611. 16510  '
  612. 16520  CRNTSUB=CRNTSUB+1
  613. 16530  IF CRNTSUB>STCKMAX THEN CRNTSUB=STCKMAX : RETURN
  614. 16540  STCKNAME$(CRNTSUB)=SUB$(S)
  615. 16550  SUBSTCK$(CRNTSUB)=SUB$(S)
  616. 16560  STCKLOOP(CRNTSUB)=LOOP
  617. 16570  RETURN
  618. 16580  ' endsub - stack generation
  619. 16590  REM = processing the stack =
  620. 16600  '
  621. 16610  B$=LEFT$(SUBSTCK$(CRNTSUB),1)
  622. 16620  SUBSTCK$(CRNTSUB)=MID$(SUBSTCK$(CRNTSUB),2)
  623. 16630  IF SUBSTCK$(CRNTSUB)="" THEN SUBSTCK$(CRNTSUB)=STCKNAME$(CRNTSUB):STCKLOOP(CRNTSUB)=STCKLOOP(CRNTSUB)-1
  624. 16640  IF STCKLOOP(CRNTSUB)<1 THEN CRNTSUB=CRNTSUB-1
  625. 16650  RETURN 11570
  626. 16660  REM == PROGRAM MENU =
  627. 16670  GOSUB 10930
  628. 16680  LOCATE 1,1:PRINT "create":PRINT:PRINT"delete":PRINT:PRINT"modify":PRINT
  629. 16710  PRINT "list":PRINT:PRINT"display":PRINT:PRINT"rename":PRINT:PRINT"store"
  630. 16750  PRINT:PRINT "append":PRINT:PRINT"get":PRINT:PRINT"key"
  631. 16780  LOCATE 22,1:PRINT "quit"
  632. 16790  RETURN
  633. 16800  REM == PROGRAM LAB ==
  634. 16810  GOSUB 16660:A$=""
  635. 16830  WHILE A$<>"quit"
  636. 16840   GOSUB 11480
  637. 16850   IF A$="create"  THEN GOSUB 17010
  638. 16860   IF A$="delete"  THEN GOSUB 17110
  639. 16870   IF A$="modify"  THEN GOSUB 18340
  640. 16880   IF A$="list"    THEN GOSUB 17250
  641. 16890   IF A$="display" THEN GOSUB 17460
  642. 16900   IF A$="rename"  THEN GOSUB 17650
  643. 16910   IF A$="store"   THEN GOSUB 17870
  644. 16920   IF A$="append"  THEN GOSUB 17960
  645. 16930   IF A$="get"     THEN GOSUB 18050
  646. 16940   IF A$="key"     THEN GOSUB 20030
  647. 16950    FOR S=0 TO AVAILSUB:IF A$=SUBNAME$(S) THEN GOSUB 16500
  648. 16960    NEXT S
  649. 16980  WEND
  650. 16990  A$=""
  651. 17000  RETURN
  652. 17010  ' create ===
  653. 17020  IF AVAILSUB=MAXSUB THEN LOCATE 25,1:PRINT "No space available";:RETURN
  654. 17030  NEWPR=1:GOSUB 17760
  655. 17040  IF NMBR>-1 THEN LOCATE 25,1:PRINT A$;" already exists";:A$="":RETURN
  656. 17050  LINE(0,192)-(320,200),0,BF
  657. 17060  LOCATE 25,20:PRINT "NOW TYPE IT IN";
  658. 17070  LOOP$=CHR$(0)+A$:GOSUB 16340:A$="":NEWPR=0
  659. 17100  RETURN
  660. 17110  ' delete ===
  661. 17120  LOCATE 25,1:LOP$=LOOP$:PRINT "Are you sure?(Y/N)";
  662. 17140  GOSUB 11480:IF A$="n" OR A$="N" THEN RETURN
  663. 17150  LOOP$=LOP$:GOSUB 17760
  664. 17160  IF NMBR=-1 THEN RETURN
  665. 17170  AVAILSUB=AVAILSUB-1
  666. 17180  FOR I=NMBR TO AVAILSUB
  667. 17190   SUB$(I)=SUB$(I+1)
  668. 17200   SUBNAME$(I)=SUBNAME$(I+1)
  669. 17210  NEXT I
  670. 17220  LINE(0,192)-(320,200),0,BF
  671. 17230  A$=""
  672. 17240  RETURN
  673. 17250  ' list ===
  674. 17260  PUT(X-DX,Y-DY),ARROW:GOSUB 15160
  675. 17270  CLS:N=AVAILSUB/24
  676. 17280  FOR I=0 TO N
  677. 17290   I24=I*24
  678. 17300   FOR J=0 TO 23
  679. 17310    I24PJ=J+I24
  680. 17320    LOCATE 1+J,1+I*7
  681. 17330    IF I24PJ<=AVAILSUB THEN PRINT LEFT$(SUBNAME$(I24PJ),7);
  682. 17340   NEXT J
  683. 17350  NEXT I
  684. 17370  LOCATE 25,1:PRINT "press any key to continue";:A$=""
  685. 17390  WHILE A$=""
  686. 17400   A$=INKEY$
  687. 17410  WEND:GOSUB 16660
  688. 17420  GOSUB 15190:PUT(X-DX,Y-DY),ARROW
  689. 17430  LINE(0,192)-(320,200),0,BF:LINE(70,0)-(319,191),CLRB,B
  690. 17440  A$=""
  691. 17450  RETURN
  692. 17460  ' display ==
  693. 17470  GOSUB 17760
  694. 17480  IF NMBR=-1 THEN RETURN
  695. 17490  LINE(0,192)-(320,200),0,BF
  696. 17500  LOCATE 25,1
  697. 17510  X$=SUB$(NMBR)
  698. 17520  LENGTH=LEN(X$)-1
  699. 17530  X$=MID$(X$,1,LENGTH)
  700. 17540  I0=1
  701. 17550  A$=""
  702. 17560  WHILE A$<>CHR$(13)
  703. 17570   A$=INKEY$
  704. 17580   IF A$=" " THEN I0=I0+35:LINE(0,192)-(320,200),0,BF
  705. 17590   IF I0>LENGTH THEN I0=1
  706. 17600   LOCATE 25,1
  707. 17610   PRINT MID$(X$,I0,39);
  708. 17620  WEND
  709. 17630  LINE(0,192)-(320,200),0,BF
  710. 17640  RETURN
  711. 17650  ' rename ===
  712. 17660  GOSUB 17760
  713. 17670  IF NMBR=-1 THEN RETURN
  714. 17680  LINE(0,192)-(320,200),0,BF
  715. 17690  LOCATE 25,20
  716. 17700  PRINT "Now rename it!";
  717. 17710  GOSUB 11480
  718. 17720  SUBNAME$(NMBR)=A$
  719. 17730  LINE(0,192)-(320,200),0,BF
  720. 17740  A$=""
  721. 17750  RETURN
  722. 17760  ' find sub, if exists ==
  723. 17770  LINE(0,192)-(320,200),0,BF:IF LOOP$<>"" THEN LOOP$=MID$(LOOP$,2)
  724. 17780  IF LOOP$="" THEN LOCATE 25,30:PRINT "NAME IT";:GOSUB 11480 ELSE A$=LOOP$
  725. 17810  NMBR=-1: IF AVAILSUB=-1 THEN GOTO 17850
  726. 17820  FOR I=0 TO AVAILSUB
  727. 17830   IF SUBNAME$(I)=A$ THEN NMBR=I
  728. 17840  NEXT I
  729. 17850  IF NMBR=-1 AND NEWPR=0 THEN LOCATE 25,1:                                        PRINT "What kind of a name is that?";
  730. 17860  RETURN
  731. 17870  ' store ==
  732. 17880  OPEN "data.sub" FOR OUTPUT AS #1
  733. 17890  PRINT #1,AVAILSUB
  734. 17900  FOR I=0 TO AVAILSUB
  735. 17920   PRINT #1,SUBNAME$(I):PRINT #1,SUB$(I)
  736. 17930  NEXT I
  737. 17940  CLOSE #1
  738. 17950  RETURN
  739. 17960  ' append ===
  740. 17970  OPEN "data.sub" FOR APPEND AS #1
  741. 17980  PRINT #1,AVAILSUB
  742. 17990  FOR I=0 TO AVAILSUB
  743. 18000   PRINT #1,SUBNAME$(I):PRINT #1,SUB$(I)
  744. 18020  NEXT I
  745. 18030  CLOSE #1
  746. 18040  RETURN
  747. 18050  ' get ==
  748. 18060  OPEN "data.sub" FOR INPUT AS #1
  749. 18070  ADDSUB = -1
  750. 18080  IF NOT EOF(1) THEN INPUT #1,ADDSUB
  751. 18090   TWO=ONE+ONE:IF AVAILSUB=-1 AND ADDSUB=-1 THEN RETURN
  752. 18100   IF AVAILSUB=-1 AND ADDSUB=-1 THEN RETURN
  753. 18110   FOR I=AVAILSUB+1 TO AVAILSUB+ADDSUB+1
  754. 18120    INPUT #1,SUBNAME$(I):LINE INPUT #1,SUB$(I)
  755. 18140    IF I<>AVAILSUB THEN INPUT #1,WASTE
  756. 18150    SUB$(I)=SUB$(I)+CHR$(13)
  757. 18160   NEXT I
  758. 18170   AVAILSUB=AVAILSUB+ADDSUB+1
  759. 18180  IF NOT EOF(1) THEN INPUT #1, ADDSUB:GOTO 18110
  760. 18190  CLOSE #1
  761. 18200  RETURN
  762. 18210  ' error handling ===
  763. 18220  ERT=ERR:PLAY "o1<bbcddcba#"
  764. 18230  WHILE INKEY$<>"":WEND:B$="" 'empty keyboard buffer
  765. 18240  :CRNTSUB=-1:LINE(0,192)-(320,200),0,BF
  766. 18250  'LOCATE 25,1:PRINT "error ";ERR;" on line ";ERL;
  767. 18260  FOR I=0 TO 1000:NEXT I
  768. 18270  LINE(0,192)-(320,200),0,BF:LOCATE 25,1
  769. 18280  IF ERR=52 OR ERR=71 THEN PRINT"Check your disk drive";
  770. 18290  IF ERR=53 THEN PRINT"File not found";
  771. 18300  IF ERR=67 OR ERR=61 THEN PRINT"Too many files, change diskette";
  772. 18310  IF ERR=5 THEN IF ERL>11480 AND ERL<11680 THEN PRINT"Don't change 1st word";:  PRINT" after 2nd began"; ELSE IF ERL=12270 THEN PRINT"Radius is too small for this width"; ELSE PRINT"Box or fix is missing I believe";
  773. 18320  IF ERL=12270 THEN LINE(0,0)-(249,191),CLRB,B
  774. 18330  RESUME NEXT
  775. 18340  'modify ==
  776. 18350  GOSUB 17760
  777. 18360  IF NMBR=-1 THEN RETURN
  778. 18370  LINE(0,192)-(320,200),0,BF
  779. 18380  LOCATE 25,1
  780. 18390  X$=SUB$(NMBR)
  781. 18400  LENGTH=LEN(X$)-1
  782. 18410  X$=MID$(X$,1,LENGTH)
  783. 18420  I0=1:PRINT MID$(X$,I0,39);
  784. 18430  A$="":IC=1 ' current position of the cursor on the 25th line
  785. 18440  WHILE A$<>CHR$(13)
  786. 18450   A$=INKEY$
  787. 18460     PUT((IC-1)*8,192),CRSR%:PUT((IC-1)*8,192),CRSR%
  788. 18470  IF LEN(A$)<>1 THEN 18520
  789. 18480   ANS=ASC(A$)
  790. 18490     IF ANS<21 OR ANS>122 THEN 18520
  791. 18500     X$=MID$(X$,1,I0+IC-2)+A$+MID$(X$,I0+IC,LENGTH)
  792. 18510     LOCATE 25,IC:PRINT A$;:IC=IC+1:GOSUB 18810
  793. 18520   WHILE LEN(A$)=2
  794. 18530     S$=MID$(A$,2,1):ANS=ASC(S$)
  795. 18540     IF ANS=82 THEN GOSUB 18680 'ins option
  796. 18550     IF ANS=77 THEN IC=IC+1:GOSUB 18810
  797. 18560     IF ANS=75 THEN IC=IC-1:GOSUB 18810
  798. 18570     IF ANS=83 THEN GOSUB 18640:LINE(0,192)-(320,200),0,BF:LOCATE 25,1:                             PRINT MID$(X$,I0,39);: 'del option
  799. 18580     A$=S$
  800. 18590   WEND
  801. 18600  WEND
  802. 18610  LINE(0,192)-(320,200),0,BF
  803. 18620  SUB$(NMBR)=X$+CHR$(13)
  804. 18630  RETURN
  805. 18640  'del ==
  806. 18650  X$=MID$(X$,1,I0+IC-2)+MID$(X$,I0+IC,LENGTH)
  807. 18660  LENGTH=LENGTH-1
  808. 18670  RETURN
  809. 18680  'ins ==
  810. 18690  A$="":S$=""
  811. 18700  WHILE LEN(A$)<>2 AND A$<>CHR$(13)
  812. 18710   A$=INKEY$
  813. 18720   PUT((IC-1)*8,192),CRSRI%:PUT((IC-1)*8,192),CRSRI%
  814. 18730   IF A$=CHR$(13) OR A$="" OR LEN(A$)=2 THEN 18760
  815. 18740   X$=MID$(X$,1,I0+IC-2)+A$+MID$(X$,I0+IC-1,LENGTH):LENGTH=LENGTH+1:                  LOCATE 25,1:PRINT MID$(X$,I0,39);
  816. 18750   IC=IC+1:GOSUB 18810:PUT((IC-1)*8,192),CRSRI%:PUT((IC-1)*8,192),CRSRI%
  817. 18760  WEND
  818. 18770  IF A$=CHR$(13) THEN S$="":ANS=0:RETURN
  819. 18780  S$=MID$(A$,2,1) : ANS=ASC(S$)
  820. 18790  RETURN
  821. 18800  '
  822. 18810  IF IC>=1 AND IC<=39 THEN RETURN
  823. 18820  IF IC<1 THEN IC=1:I0=I0-1:IF I0<1 THEN I0=1
  824. 18830  IF IC>39 THEN IC=39:I0=I0+1:IF I0>LENGTH THEN I0=LENGTH
  825. 18840  LINE(0,192)-(320,200),0,BF:LOCATE 25,1:PRINT MID$(X$,I0,39);
  826. 18850  RETURN
  827. 18860  'sprite motion statement
  828. 18870  GOSUB 10930 ' erase previous menu
  829. 18880  LOCATE 1,1
  830. 18890  PRINT "Use ";CHR$(27);CHR$(25);CHR$(26);CHR$(24)
  831. 18900  PRINT "to move":PRINT"sprite":PRINT:PRINT"Control":PRINT"speed":PRINT"hitting"
  832. 18910  PRINT :PRINT"+ or -":PRINT:PRINT:PRINT"Use":PRINT"Enter":PRINT"key to"
  833. 18920  PRINT "quit"
  834. 18930  RETURN
  835. 18940  ' sprite motion section ==
  836. 18950  GOSUB 18860:C$=""
  837. 18960  WHILE C$<>CHR$(13)
  838. 18970   C$=INKEY$:L=LEN(C$):IF L=1 THEN GOSUB 19140 ELSE GOSUB 19020
  839. 18980  WEND
  840. 18990  A$="":GOSUB 20510
  841. 19000  IF TRACK=0 AND D3=0 THEN PUT(0,0),WDOWN                                                             ELSE IF D3=0 THEN PUT(0,64),WERASE ELSE PUT(0,80),WUP
  842. 19010  RETURN
  843. 19020  'sprite response: move =
  844. 19030  IF L<>2 THEN RETURN
  845. 19040  ANS=ASC(MID$(C$,2,1))
  846. 19050  DELX=0 : DELY=0
  847. 19060  IF ANS=71 OR ANS=72 OR ANS=73 THEN DELY=-SPD ELSE                               IF ANS=79 OR ANS=80 OR ANS=81 THEN DELY= SPD
  848. 19070  IF ANS=71 OR ANS=75 OR ANS=79 THEN DELX=-SPD ELSE                               IF ANS=73 OR ANS=77 OR ANS=81 THEN DELX= SPD
  849. 19080  XNEW=XOLD+DELX : YNEW=YOLD+DELY
  850. 19090  IF XNEW<71 OR XNEW>319-BOX(0)/2 THEN RETURN
  851. 19100  IF YNEW<1  OR YNEW>190-BOX(1) THEN RETURN
  852. 19110  IF TRACK=0 AND D3=0 THEN PUT(XOLD,YOLD),BOX:PUT(XNEW,YNEW),BOX ELSE             IF D3=1 THEN PUT(XNEW,YNEW),BOX,PSET ELSE PUT(XNEW,YNEW),BOX
  853. 19120  XOLD=XNEW : YOLD=YNEW : C$="" : L=0
  854. 19130  RETURN
  855. 19140  ' sprite response : speed ==
  856. 19150  IF C$="+" THEN SPD=SPD+1
  857. 19160  IF C$="-" THEN SPD=SPD-1:IF SPD<0 THEN SPD=SPD+1
  858. 19170  RETURN
  859. 19180  'handling variables ==
  860. 19190  NVAR=VAL(MID$(A$,4,1))
  861. 19200  IF MID$(A$,5,1)<>"=" THEN RETURN
  862. 19210  LV$="" : OP$="" : RV$="" : LR=-1
  863. 19220  FOR L=6 TO LEN(A$)
  864. 19230   LC$=MID$(A$,L,1)
  865. 19240   IF INSTR("*+-/^",LC$) THEN OP$=LC$:LR=0
  866. 19250   IF LR=-1 THEN LV$=LV$+LC$ ELSE IF LR=1 THEN RV$=RV$+LC$
  867. 19260   IF LR=0 THEN LR=1
  868. 19270  NEXT L
  869. 19280  IF LEFT$(LV$,3)="var" THEN LV=VAR(VAL(MID$(LV$,4,1)))                                                 ELSE LV=VAL(LV$)
  870. 19290  IF OP$="" THEN VAR(NVAR)=LV                         : RETURN
  871. 19300  IF LEFT$(RV$,3)="var" THEN RV=VAR(VAL(MID$(RV$,4,1)))                                                 ELSE RV=VAL(RV$)
  872. 19310  IF OP$="+" THEN VAR(NVAR)=LV+RV
  873. 19320  IF OP$="-" THEN VAR(NVAR)=LV-RV
  874. 19330  IF OP$="/" THEN IF RV=0 THEN LOCATE 25,1:PRINT"No division by zero,silly!";:RETURN 12140 ELSE VAR(NVAR)=LV/RV
  875. 19340  IF OP$="^" THEN VAR(NVAR)=LV^RV
  876. 19350  IF OP$="*" THEN VAR(NVAR)=LV*RV
  877. 19360  RETURN 12140
  878. 19370  ' print out variables ==
  879. 19380  LOCATE 25,1
  880. 19390  FOR I=0 TO 9
  881. 19400   PRINT VAR(I);
  882. 19410  NEXT I
  883. 19420  RETURN 12140
  884. 19430  ' status ===
  885. 19440  A$="":STNUM=1
  886. 19450  WHILE A$<>CHR$(13) : A$=INKEY$
  887. 19460   IF A$=" " THEN STNUM=STNUM+1
  888. 19470   ON STNUM GOSUB 19510,19550,19560,19550,19640
  889. 19480   STNUM=STNUM MOD 6
  890. 19490  WEND : LINE(0,192)-(320,200),0,BF
  891. 19500  RETURN 12140
  892. 19510  LINE(0,192)-(320,200),0,BF:STNUM=STNUM+1
  893. 19520  LOCATE 25,1:PRINT "step";STP;:PRINT":width";WDTH*2-1;
  894. 19530  IF SCRPOS$="right" THEN F$="west" ELSE F$="east"
  895. 19540  PRINT ":";F$;". part";
  896. 19550  RETURN
  897. 19560  LINE(0,192)-(320,200),0,BF:STNUM=STNUM+1
  898. 19570  LOCATE 25,1:PRINT"ground ";:IF BCKGR>7 THEN PRINT"bright ";
  899. 19580  PRINT BCKGR$;
  900. 19590  IF PLT=0 THEN IF CLRB=1 THEN F$="green" ELSE IF CLRB=2 THEN F$="red" ELSE                     IF CLRB=3 THEN F$="brown" ELSE F$=BCKGR$
  901. 19600  IF PLT=1 THEN IF CLRB=1 THEN F$="cyan" ELSE IF CLRB=2 THEN F$="purple"                   ELSE IF CLRB=3 THEN F$="white" ELSE F$=BCKGR$
  902. 19610  PRINT":arrow ";F$;
  903. 19620  RETURN
  904. 19630  LOCATE 25,1:PRINT"arrow position: x=";MID$(STR$(X),2);" y=";MID$(STR$(Y),2);
  905. 19640  LINE(0,192)-(320,200),0,BF:STNUM=STNUM+1
  906. 19650  LOCATE 25,1:PRINT"arrow position: x=";MID$(STR$(X),2);" y=";MID$(STR$(Y),2);
  907. 19660  RETURN
  908. 19670  ' text section ===
  909. 19680  GOSUB 10930 ' erase previous menu
  910. 19690  LOCATE 1,1
  911. 19700  PRINT "Use ";CHR$(27);CHR$(25);CHR$(26);CHR$(24)
  912. 19710  PRINT "to move":PRINT"cursor":PRINT:PRINT:PRINT:PRINT"Use"
  913. 19720  PRINT "Enter":PRINT"key to":PRINT"quit"
  914. 19730  '
  915. 19740  ASPD=8:AXOLD=72:AYOLD=0:AXNEW=AXOLD:AYNEW=AYOLD
  916. 19750  PUT(AXOLD,AYOLD),TEXTCRS%
  917. 19760  PUT(X-DX,Y-DY),ARROW:C$=""
  918. 19770  WHILE C$<>CHR$(13)
  919. 19780   C$=INKEY$:L=LEN(C$):IF L=1 THEN GOSUB 19950 ELSE GOSUB 19820
  920. 19790  WEND
  921. 19800  PUT(X-DX,Y-DY),ARROW:PUT(AXNEW,AYNEW),TEXTCRS%:GOSUB 10930
  922. 19810  RETURN
  923. 19820  'text response: move ===
  924. 19830  IF L<>2 THEN RETURN
  925. 19840  ANS=ASC(MID$(C$,2,1))
  926. 19850  ADELX=0 : ADELY=0
  927. 19860  IF ANS=71 OR ANS=72 OR ANS=73 THEN ADELY=-ASPD ELSE                             IF ANS=79 OR ANS=80 OR ANS=81 THEN ADELY= ASPD
  928. 19870  IF ANS=71 OR ANS=75 OR ANS=79 THEN ADELX=-ASPD ELSE                             IF ANS=73 OR ANS=77 OR ANS=81 THEN ADELX= ASPD
  929. 19880  AXNEW=AXOLD+ADELX : AYNEW=AYOLD+ADELY
  930. 19890  IF AXNEW<72 OR AXNEW>304 THEN AXNEW=AXOLD:RETURN
  931. 19900  IF AYNEW<0  OR AYNEW>184 THEN AYNEW=AYOLD:RETURN
  932. 19910  PUT(AXOLD,AYOLD),TEXTCRS%:PUT(AXNEW,AYNEW),TEXTCRS%
  933. 19920  AXOLD=AXNEW : AYOLD=AYNEW : C$="" : L=0
  934. 19930  RETURN
  935. 19940  '
  936. 19950  ' text response : print
  937. 19960  IF ASC(C$)>8 AND ASC(C$)<14 THEN RETURN
  938. 19970  AX=AXOLD/8+1 : AY=AYOLD/8+1:LOCATE AY,AX:PRINT C$;:AXNEW=AXOLD+ASPD
  939. 19980  IF AXNEW>304 THEN AXNEW=72 : AYNEW=AYOLD+ASPD
  940. 19990  IF AYNEW>184 THEN AYNEW=0
  941. 20000  PUT(AXNEW,AYNEW),TEXTCRS%
  942. 20010  AXOLD=AXNEW : AYOLD=AYNEW
  943. 20020  RETURN
  944. 20030  'key - program ====
  945. 20040  PRGRM=1:LOCATE 25,20 : PRINT"What number (1-10)?";:GOSUB 11480
  946. 20050  K=VAL(A$) : IF K<1 OR K>10 THEN 20040
  947. 20060  LOCATE 25,5 : PRINT"Define it! Shorter than 15 symbols!";
  948. 20070  GOSUB 11480:K$=A$
  949. 20080  LOCATE 25,10:PRINT"Add ENTER (";CHR$(17);CHR$(196);CHR$(217);") key (Y/N)?";
  950. 20090  GOSUB 11480:IF A$="y" THEN K$=K$+CHR$(13)
  951. 20100  KEY(K) OFF:KEY K,K$:PRGRM=0
  952. 20110  RETURN
  953. 20120  'net =====
  954. 20130  X1=X MOD STP : Y1=Y MOD STP : STP3=STP*3
  955. 20140  NX=320/STP3 : NY=200/STP3
  956. 20150  FOR I=1 TO NX : XD=X1+(I-1)*STP3 : IF XD<=70 OR XD=>319 THEN 20190
  957. 20160   FOR J=1 TO NY : YD=Y1+(J-1)*STP3 : IF YD<=1 OR YD=>191 THEN 20180
  958. 20170    PUT(XD-1,YD-1),PNT%
  959. 20180   NEXT J
  960. 20190  NEXT I
  961. 20200  RETURN
  962. 20210  ' undo ===
  963. 20230  PUT(X-DX,Y-DY),ARROW
  964. 20240  GOSUB 15190
  965. 20250  RETURN
  966. 20260  'sprite definition section
  967. 20270  D3=0:TRACK=0:SPD=8:XOLD=X:YOLD=Y:GOSUB 20510:PUT(0,0),WDOWN
  968. 20280  PUT(X-DX,Y-DY),ARROW
  969. 20290  A$=""
  970. 20300  WHILE A$<>"quit"
  971. 20310   GOSUB 11480
  972. 20320   IF A$="move"    THEN GOSUB 20820
  973. 20330   IF A$="reverse" THEN GOSUB 20440
  974. 20340   IF A$="ns-flip" THEN GOSUB 20580
  975. 20350   IF A$="ew-flip" THEN GOSUB 20670
  976. 20360   IF A$="track"   THEN GOSUB 20760
  977. 20370   IF A$="3d"      THEN GOSUB 20890
  978. 20380   IF A$="start"   THEN IF RUBON=0 THEN GOSUB 18940 ELSE GOSUB 21080
  979. 20390   IF A$="rotate"  THEN GOSUB 20950
  980. 20400   IF A$="rubber"  THEN GOSUB 21060
  981. 20410  WEND
  982. 20420  PUT(X-DX,Y-DY),ARROW:A$="":GOSUB 11040:RUBON=0
  983. 20430  RETURN 12140
  984. 20440  'reverse sprite
  985. 20450  PUT(XOLD,YOLD),BOX
  986. 20460  FOR I=2 TO IN
  987. 20470  BOX(I)=BOX(I) XOR -1
  988. 20480  NEXT I
  989. 20490  PUT(XOLD,YOLD),BOX:GOSUB 18940
  990. 20500  RETURN
  991. 20510  'sprite menu
  992. 20520  GOSUB 10930
  993. 20530  LOCATE 1,1:PRINT"move"
  994. 20540  PRINT:PRINT"reverse":PRINT:PRINT"ns-flip":PRINT:PRINT"ew-flip"
  995. 20550  PRINT:PRINT"track":PRINT:PRINT"3D":PRINT:PRINT"start"
  996. 20560  PRINT:PRINT"rotate":PRINT:PRINT"rubber":PRINT:PRINT:PRINT"quit"
  997. 20570  RETURN
  998. 20580  'ns-flip
  999. 20590  IY=BOX(1)-1+YOLD
  1000. 20600  FOR I=0 TO BOX(0)/2-1:XX=XOLD+I
  1001. 20610   FOR J=1 TO BOX(1)/2:J1=J-1:Y1=YOLD+J1:Y2=IY-J1
  1002. 20620    B1=POINT(XX,Y1):B2=POINT(XX,Y2):PSET(XX,Y1),B2:PSET(XX,Y2),B1
  1003. 20630   NEXT J
  1004. 20640  NEXT I
  1005. 20650  GET(XOLD,YOLD)-(XOLD+BOX(0)/2-1,YOLD+BOX(1)-1),BOX
  1006. 20660  RETURN
  1007. 20670  'ew-flip
  1008. 20680  IX=BOX(0)/2-1+XOLD
  1009. 20690  FOR I=1 TO BOX(0)/4:I1=I-1:X1=XOLD+I1:X2=IX-I1
  1010. 20700   FOR J=0 TO BOX(1)-1:YY=YOLD+J
  1011. 20710    B1=POINT(X1,YY):B2=POINT(X2,YY):PSET(X1,YY),B2:PSET(X2,YY),B1
  1012. 20720   NEXT J
  1013. 20730  NEXT I
  1014. 20740  GET(XOLD,YOLD)-(XOLD+BOX(0)/2-1,YOLD+BOX(1)-1),BOX
  1015. 20750  RETURN
  1016. 20760  'track
  1017. 20770  IF TRACK=1 THEN RETURN ELSE PUT(0,64),WERASE:TRACK=1
  1018. 20780  IF D3=0 THEN PUT(0,0),WDOWN ELSE PUT(0,80),WUP:D3=0
  1019. 20790  IF RUBON=1 THEN GOSUB 21080:RETURN
  1020. 20800  GOSUB 18940
  1021. 20810  RETURN
  1022. 20820  'move
  1023. 20830  IF TRACK=0 AND D3=0 THEN RETURN ELSE PUT(0,0),WDOWN
  1024. 20840  IF TRACK=1 THEN PUT(0,64),WERASE ELSE PUT(0,80),WUP
  1025. 20860  TRACK=0:D3=0:IF RUBON=1 THEN GOSUB 21080:RETURN
  1026. 20870  GOSUB 18940
  1027. 20880  RETURN
  1028. 20890  '3D
  1029. 20900  IF D3=1 THEN RETURN ELSE PUT(0,80),WUP:D3=1
  1030. 20910  IF TRACK=0 THEN PUT(0,0),WDOWN ELSE PUT(0,64),WERASE:TRACK=0
  1031. 20920  IF RUBON=1 THEN GOSUB 21080:RETURN
  1032. 20930  GOSUB 18940
  1033. 20940  RETURN
  1034. 20950  'rotate
  1035. 20960  IF BOX(0)/2<>BOX(1) THEN LOCATE 25,1:PRINT"The box is not square, sorry";:      RETURN
  1036. 20970  B=BOX(1):A2=B-2:A1X=XOLD+B-1:A1Y=YOLD+B-1
  1037. 20980  FOR I=0 TO A2:AXI=A1X-I:AYI=A1Y-I:XI=XOLD+I:YI=YOLD+I
  1038. 20990   FOR J=I TO A2-I:AXJ=A1X-J:AYJ=A1Y-J:XJ=XOLD+J:YJ=YOLD+J
  1039. 21000    BO=POINT(XI,YJ):PSET(XI,YJ),POINT(AXJ,YI):PSET(AXJ,YI),POINT(AXI,AYJ)
  1040. 21010    PSET(AXI,AYJ),POINT(XJ,AYI):PSET(XJ,AYI),BO
  1041. 21020   NEXT J
  1042. 21030  NEXT I
  1043. 21040  GET(XOLD,YOLD)-(XOLD+BOX(1)-1,YOLD+BOX(1)-1),BOX
  1044. 21050  RETURN
  1045. 21060  ' rubber motion section ==
  1046. 21070  IF RUBON=0 THEN RUBON=1 ELSE RUBON=0:PUT(0,128),WUP:PUT(16,128),WDOWN
  1047. 21080  IF RUBON=0 THEN RETURN
  1048. 21090  GOSUB 18860:C$="":PUT(XOLD-1,YOLD-1),BRUBV
  1049. 21100  IF D3=1 OR TRACK=1 THEN PUT(XOLD,YOLD),BRUB,PSET
  1050. 21110  WHILE C$<>CHR$(13)
  1051. 21120   C$=INKEY$:L=LEN(C$):IF L=1 THEN GOSUB 19140 ELSE GOSUB 21180
  1052. 21130  WEND
  1053. 21140  A$="":GOSUB 20510:PUT(0,128),WUP:PUT(16,128),WDOWN
  1054. 21150  IF TRACK=0 AND D3=0 THEN PUT(0,0),WDOWN                                                             ELSE IF D3=0 THEN PUT(0,64),WERASE ELSE PUT(0,80),WUP
  1055. 21160  PUT(XOLD-1,YOLD-1),BRUBV
  1056. 21170  RETURN
  1057. 21180  'rubber response: move =
  1058. 21190  IF L<>2 THEN RETURN
  1059. 21200  DELX=0:DELY=0:ANS=ASC(MID$(C$,2,1))
  1060. 21220  IF ANS=71 OR ANS=72 OR ANS=73 THEN DELY=-SPD ELSE                               IF ANS=79 OR ANS=80 OR ANS=81 THEN DELY= SPD
  1061. 21230  IF ANS=71 OR ANS=75 OR ANS=79 THEN DELX=-SPD ELSE                               IF ANS=73 OR ANS=77 OR ANS=81 THEN DELX= SPD
  1062. 21240  XNEW=XOLD+DELX : YNEW=YOLD+DELY
  1063. 21250  IF XNEW<71 OR XNEW>319-BRUB(0)/2 THEN RETURN
  1064. 21260  IF YNEW<1  OR YNEW>190-BRUB(1) THEN RETURN
  1065. 21270  PUT(XOLD-1,YOLD-1),BRUBV:PUT(XNEW-1,YNEW-1),BRUBV
  1066. 21280  IF D3=1 OR TRACK=1 THEN PUT(XNEW,YNEW),BRUB,PSET
  1067. 21290  XOLD=XNEW : YOLD=YNEW : C$="" : L=0
  1068. 21300  RETURN
  1069. 21310  'interup a crazy subroutine, press F10
  1070. 21320  CRNTSUB=-1
  1071. 21330  RETURN
  1072. 21340  'if.neg
  1073. 21350  IF MID$(LOOP$,1,4)<>" var" THEN RETURN
  1074. 21360  NVAR$=MID$(LOOP$,5,1):IF NVAR$<"0" OR NVAR$>"9" THEN RETURN
  1075. 21370  NVAR=VAL(NVAR$) : IF VAR(NVAR)<0 THEN SUBSTCK$(CRNTSUB)=""
  1076. 21380  RETURN
  1077. 21390  'week
  1078. 21400   TM=1:GOSUB 15390:CLS:TM=0
  1079. 21410   SC=240:TC=90:R=20:RR=15:S=0:T=-1:SS=0:TT=-1:FSTSLOW=1:LEVEL=10:HM=10
  1080. 21420   LINE(240,65)-(240,68):LINE(240,115)-(240,112):AMPM$="A":H=0:HOUR=0
  1081. 21430   LINE(215,90)-(218,90):LINE(265,90)-(262,90):MIN=0:DAYSTART=0:DAY=0
  1082. 21440   FI=3.14159*HM/30:CS=COS(FI):SN=SIN(FI):CS1=COS(FI/2):SN1=SIN(FI/2)
  1083. 21450   FOR I=1 TO 7:DAY=DAY+1:GOSUB 21490:NEXT I
  1084. 21460   DAYSTART=1:DAY=DAYREM-1:CIRCLE(SC,TC),25,3,,,RATIO:GOSUB 21730
  1085. 21470   PUT(X-DX,Y-DY),ARROW:GOSUB 20210:LINE(70,0)-(319,191),CLRB,B:DAYREM=DAY
  1086. 21480  RETURN
  1087. 21490  ' days
  1088. 21500   CORNER=(DAY+1)*2:C1=(2*DAY+3)*8:IF DAY=1 THEN CORNER=18
  1089. 21510   C2=(CORNER-1)*8+1
  1090. 21520   LOCATE CORNER,12:PRINT DAYS$(DAY-1):LINE(86,C2-3)-(161,C2+8),3,B
  1091. 21530   IF DAYSTART=1 THEN PUT(88,C1),WERASE,PSET:PUT(128,C1),WDOWN,PSET
  1092. 21540  RETURN
  1093. 21550  ' days bonus
  1094. 21560   LOCATE 25,10:PRINT"What day is it?";:GOSUB 11480
  1095. 21570   IF INSTR(DAYS$(DAY MOD 7),MID$(A$,2)) THEN GOSUB 21590
  1096. 21580  RETURN
  1097. 21590   SCORE=SCORE+LEVEL:LOCATE 18,37:PRINT MID$(STR$(SCORE),2)
  1098. 21600   A$="L2DF+L1A":B$="L4MSGF+E":PLAY"MBT200O3"+A$+A$+B$+"F+"+B$+"L2AAA":GOSUB 22280:GOSUB 21620
  1099. 21610  RETURN
  1100. 21620   DAY=DAY+1:IF DAY=8 THEN DAY=1
  1101. 21630   IF DAYSTART=1 THEN GOSUB 21490
  1102. 21640  RETURN
  1103. 21650  'clock
  1104. 21660   TM=1:GOSUB 15390:TM=0:DEF SEG=&HB800 : BLOAD "clock.pic"
  1105. 21670   SC=181 : TC=96 : HM=1 : FI=3.14159/30 : CS=COS(FI) : SN=SIN(FI)
  1106. 21680   R=65:RR=40:S=SREM:T=TREM:SS=SSREM:TT=TTREM:H=HREM:MIN=MINREM:HOUR=HOUREM
  1107. 21690   AMPM$=AMPMREM$:CS1=COS(FI/2):SN1=SIN(FI/2):DAYSTART=0:GOSUB 21730
  1108. 21700   MINREM=MIN:HREM=H:HOUREM=HOUR:SREM=S:TREM=T:SSREM=SS:TTREM=TT:AMPMREM$=AMPM$
  1109. 21710   PUT(X-DX,Y-DY),ARROW:GOSUB 20210:LINE(70,0)-(319,191),CLRB,B:DEF SEG
  1110. 21720  RETURN
  1111. 21730  'clock drawing and the clock game
  1112. 21740  LINE(70,0)-(319,191),CLRB,B:PAINT(72,3),1,3
  1113. 21750  LOCATE 19,35:PRINT"score":LOCATE 18,37:PRINT MID$(STR$(SCORE),2):GOSUB 22190
  1114. 21760  GOSUB 22250
  1115. 21770  LINE (SC,TC)-(SC+S*R,TC+T*R):LINE(SC,TC)-(SC+SS*RR,TC+TT*RR),2:C$=""
  1116. 21780  WHILE C$<>" "
  1117. 21790   C$=INKEY$:IF C$=CHR$(13) THEN GOSUB 22020
  1118. 21800  IF C$="+" THEN FSTSLW=1 ELSE IF C$="-" THEN FSTSLW=0
  1119. 21810   S1=S*CS-T*SN : T1=T*CS+S*SN : IF FSTSLW=0 THEN GOSUB 21960
  1120. 21820   LINE(SC,TC)-(SC+S*R,TC+T*R),0 : LINE(SC,TC)-(SC+SS*RR,TC+TT*RR),2
  1121. 21830   LINE(SC,TC)-(SC+S1*R,TC+T1*R)
  1122. 21840   MIN=MIN+HM : H=H+HM : S=S1 : T=T1 : IF MIN=60 THEN MIN=0 : S=0 : T=-1
  1123. 21850   IF H=6*HM THEN GOSUB 21890 ELSE IF FSTSLW=0 THEN FOR I=1 TO 100 : NEXT I
  1124. 21860   LOCATE 25,32:PRINT STR$(INT(HOUR/10));":";MID$(STR$(MIN),2);"  ";
  1125. 21870  WEND
  1126. 21880  RETURN
  1127. 21890   SS1=SS*CS1-TT*SN1 : TT1=TT*CS1+SS*SN1
  1128. 21900   LINE(SC,TC)-(SC+SS*RR,TC+TT*RR),0 : LINE(SC,TC)-(SC+S*R,TC+T*R)
  1129. 21910   LINE(SC,TC)-(SC+SS1*RR,TC+TT1*RR),2
  1130. 21920   SS=SS1 : TT=TT1 : H=0 : HOUR=HOUR+HM : LOCATE 10,36
  1131. 21930   IF HOUR=120 THEN S1=0:T1=-1 : IF AMPM$="P" THEN AMPM$="A":HOUR=0:GOSUB 22250 ELSE AMPM$="P":GOSUB 22250
  1132. 21940   IF AMPM$="P" THEN IF HOUR=>130 THEN HOUR=HOUR-120
  1133. 21950  RETURN
  1134. 21960  '
  1135. 21970  PLAY "mb"
  1136. 21980   SOUND 450,0.25 : SOUND 100,0 : FOR J=1 TO 5 : NEXT J
  1137. 21990   SOUND  70,0.25 : SOUND 100,0
  1138. 22000   FOR I=1 TO 200:NEXT I
  1139. 22010  RETURN
  1140. 22020  'clock game
  1141. 22030   LINE(0,192)-(320,200),0,BF:IF DAYSTART=1 THEN GOSUB 21550:RETURN
  1142. 22040   DMIN=-1:LOCATE 25,10:PRINT"choose level (1-5)";:GOSUB 11480:LEVEL=VAL(A$)
  1143. 22050   IF A$<"1" OR A$>"5" THEN 22030
  1144. 22060   IF A$="5" THEN DMIN=0 ELSE IF A$="4" THEN DMIN=1 ELSE IF A$="3" THEN                           DMIN=2 ELSE IF A$="2" THEN DMIN=3
  1145. 22070   LOCATE 25,10:PRINT "hour?";:GOSUB 11480:VA10=VAL(A$)*10
  1146. 22080   IF VA10<=HOUR AND HOUR<(VA10+10) THEN GOSUB 22130 ELSE RETURN
  1147. 22090   IF DMIN=-1 THEN RETURN
  1148. 22100   LOCATE 25,10:PRINT"minutes?";:GOSUB 11480
  1149. 22110   IF MIN-DMIN<=VAL(A$) AND VAL(A$)<=MIN+DMIN THEN GOSUB 22160 ELSE RETURN
  1150. 22120  RETURN
  1151. 22130   SCORE=SCORE + 1  :LOCATE 18,37:PRINT MID$(STR$(SCORE),2):A$="MBO3T230L2CGCGCL1GL2GL4A-":B$="MSGFE-DC":PLAY A$+B$+B$
  1152. 22140   GOSUB 22280
  1153. 22150  RETURN
  1154. 22160   SCORE=SCORE+LEVEL:LOCATE 18,37:PRINT MID$(STR$(SCORE),2):PLAY"MBO3T190L4FEDFEDFMSAABCCCCDEDEDEDCCBBMF"
  1155. 22170   GOSUB 22280
  1156. 22180  RETURN
  1157. 22190  'clock menu
  1158. 22200  GOSUB 10930:LOCATE 1,1
  1159. 22210  PRINT "Press":PRINT CHR$(17);CHR$(196);CHR$(217)+" key"
  1160. 22220  PRINT "to play":PRINT:PRINT:PRINT"+  fast":PRINT"-  slow":PRINT:PRINT
  1161. 22230  PRINT:PRINT:PRINT"Press":PRINT"space":PRINT"bar":PRINT"to quit"
  1162. 22240  RETURN
  1163. 22250   LOCATE 10,36 : PRINT AMPM$+".M."': PAINT(292,77),1,3
  1164. 22260   IF AMPM$="A" THEN GOSUB 21620
  1165. 22270  RETURN
  1166. 22280  'faces
  1167. 22290  LOCATE 18,1:PRINT STRING$(6,CHR$(1)):I0=0:A$="$"
  1168. 22300  LOCATE 20,3:PRINT CHR$(2);CHR$(2):LOCATE 21,3:PRINT CHR$(2)
  1169. 22310  FOR J=1 TO 5
  1170. 22320   FOR I=1 TO 5:GOSUB 22390:LOCATE 18+I,6:PRINT CHR$(1):LOCATE 18,I  :PRINT " ":NEXT I
  1171. 22330   FOR I=1 TO 5:GOSUB 22390:LOCATE 23,6-I:PRINT CHR$(1):LOCATE 17+I,6:PRINT " ":NEXT I
  1172. 22340   FOR I=1 TO 5:GOSUB 22390:LOCATE 23-I,1:PRINT CHR$(1):LOCATE 23,7-I:PRINT " ":NEXT I
  1173. 22350   FOR I=1 TO 5:GOSUB 22390:LOCATE 18,I+1:PRINT CHR$(1):LOCATE 24-I,1:PRINT " ":NEXT I
  1174. 22360  NEXT J
  1175. 22370  FOR I=1 TO 6:LOCATE 18,7-I:PRINT " ":NEXT I:LOCATE 21,3:PRINT " "
  1176. 22380  RETURN
  1177. 22390  I0=I0+1
  1178. 22400  ON I0 GOTO 22410,22420,22430,22440
  1179. 22410   LOCATE 21,4:PRINT CHR$(2):LOCATE 21,3:PRINT " ":RETURN
  1180. 22420   LOCATE 20,4:PRINT CHR$(2):LOCATE 21,4:PRINT " ":RETURN
  1181. 22430   LOCATE 20,3:PRINT CHR$(2):LOCATE 20,4:PRINT " ":RETURN
  1182. 22440   LOCATE 21,3:PRINT CHR$(2):LOCATE 20,3:PRINT " ":I0=0:RETURN
  1183. 22450  RETURN
  1184. 22460  'files
  1185. 22470   TM=1:GOSUB 15390:CLS:TM=0
  1186. 22480   D$="a":IF LOOP$<>"" THEN D$=MID$(LOOP$,2)
  1187. 22490   FILES D$+":*.pic"
  1188. 22500   IF ERT=53 OR ERT=71 OR ERT=52 THEN 22530
  1189. 22510   LOCATE 25,10:PRINT"hit a key to continue":WHILE INKEY$="":WEND
  1190. 22520   LINE(0,192)-(320,200),0,BF
  1191. 22530   GOSUB 11140
  1192. 22540   PUT(X-DX,Y-DY),ARROW:GOSUB 20210:LINE(70,0)-(319,191),CLRB,B:ERT=0
  1193. 22550  RETURN
  1194.